home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PASCALL / TEMPJUNK / COLORS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-25  |  2KB  |  87 lines
  1. program colors;
  2. uses
  3.      crt,graph;
  4.  
  5. procedure setupgraph;
  6. const
  7.      solidtype:fillpatterntype=($AA,$AA,$AA,$AA,$AA,$AA,$AA,$AA);
  8. var
  9.      graphdriver,graphmode:integer;
  10. begin
  11.      graphdriver:=vga;
  12.      graphmode:=vgahi;
  13.      initgraph(graphdriver,graphmode,'c:\tp\bgi');
  14.      if graphresult<>grOk then halt;
  15.      cleardevice;
  16.      setfillstyle(solidfill,black);
  17.      setfillpattern(solidtype,black);
  18. end;
  19.  
  20.  
  21. procedure beamingcolors;
  22. var
  23.      a:byte;
  24.      b:longint;
  25. begin
  26.      for a:=0 to getmaxcolor do
  27.      begin
  28.           setcolor(a);
  29.           for b:=10*a to (a+1)*10 do circle(320,240,b);
  30.      end;
  31. end;
  32.  
  33.  
  34. procedure setpalettefirst;
  35. var
  36.      palette:palettetype;
  37.      a:byte;
  38. begin
  39.      getpalette(palette);
  40.      for a:=0 to palette.size-1 do palette.colors[a]:=a;
  41.      setallpalette(palette);
  42. end;
  43.  
  44.  
  45. procedure changepalette(var stop:boolean);
  46. var
  47.      palette:palettetype;
  48.      a:word;
  49.      b:string;
  50.      txh,txw:integer;
  51. begin
  52.      txh:=textheight('I');     txw:=textwidth('HHH');
  53.      getpalette(palette);
  54.      with palette do for a:=0 to size-1 do
  55.      begin
  56.           colors[a]:=colors[a]+8;
  57.           str(colors[a],b);
  58.           setcolor(white);
  59.           bar(txw*a,0,txw*(a+1),txh);
  60.           outtextxy(txw*a,1,b);
  61.      end;
  62.      if palette.colors[palette.size-1]>=127 then stop:=true else stop:=false;
  63.      setallpalette(palette);
  64. end;
  65.  
  66.  
  67. procedure control;
  68. var
  69.      stop:boolean;
  70. begin
  71.      setupgraph;
  72.      setpalettefirst;
  73.      beamingcolors;
  74.      repeat
  75. {          readln;}
  76.           delay(50);
  77.           readln;
  78.           changepalette(stop);
  79.      until (stop) or (keypressed) ;
  80.      closegraph;
  81. end;
  82.  
  83.  
  84. begin
  85.      control;
  86. end.
  87.